home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / aijournl / 1987_03 / exprt3.mar < prev    next >
Lisp/Scheme  |  1987-02-21  |  4KB  |  107 lines
  1. ;  M I S S I O N A R I E S   A N D   C A N N I B A L S
  2. ;
  3. ;  The following routines, when used in conjunction with the state-space
  4. ;  search procedure, solve the missionaries and cannibals problem.  Three
  5. ;  missionaries and 3 cannibals are located on the right bank of a river,
  6. ;  along with a two-man rowboat.  We must find a way of moving all the
  7. ;  missionaries and cannibals to the left bank.  However, if at any time
  8. ;  there are more cannibals than missionaries on a bank, the cannibals will
  9. ;  exhibit a consuming interest in the misssionaries;  this must be avoided.
  10. ;
  11. ;  Each state is represented by an atom with the following properties:
  12. ;      position -- a list of three elements,
  13. ;        the number of missionaries on the right bank
  14. ;        the number of cannibals on the right bank
  15. ;        the position of the boat (left or right)
  16. ;    g       -- the estimated g for that state
  17. ;    h       -- the estimated h (value of function heuristic) 
  18. ;    parent  -- the preceding state on the path from the initial state
  19. ;                (the preceding state which gives rise to the least g,
  20. ;                        if there are several)
  21.  
  22. (defun initial-state ()
  23.   ;  return the initial state
  24.   (build-state 3 3 'right 0 nil))
  25.  
  26. (defun successors (state)
  27.   ;  returns the successors of state
  28.   ;  note that procedure try uses state and new-g, and modifies suc
  29.   (prog (m c boat new-g suc)  
  30.     ;  extract parameters of current position and put in m, c, and boat
  31.     (setq m (car (get state 'position)))
  32.     (setq c (cadr (get state 'position)))
  33.     (setq boat (caddr (get state 'position)))
  34.     ;  g of new state = g of old state + 1 (all crossings are unit cost)
  35.     (setq new-g (+ 1 (get state 'g)))
  36.     (cond ((equal boat 'right)
  37.            (try (- m 2) c 'left new-g)
  38.            (try (- m 1) c 'left new-g)
  39.            (try (- m 1) (- c 1) 'left new-g)
  40.            (try m (- c 1) 'left new-g)
  41.            (try m (- c 2) 'left new-g))
  42.           (t  ; boat is on left
  43.            (try (+ m 2) c 'right)
  44.            (try (+ m 1) c 'right)
  45.            (try (+ m 1) (+ c 1) 'right)
  46.            (try m (+ c 1) 'right)
  47.            (try m (+ c 2) 'right)))
  48.     (return suc)))
  49.  
  50. (defun try (new-m new-c new-boat new-g)
  51.   ;  if position(new-m,new-c,new-boat) is valid, add new state to suc
  52.   (cond ((valid new-m new-c)
  53.      (setq suc (cons (build-state new-m new-c new-boat new-g state)
  54.              suc)))))
  55.  
  56. (defun valid (miss cann)
  57.   ;  returns true if having 'miss' missionaries and 'cann' cannibals
  58.   ;  on the right bank is a valid state
  59.   (and (>= miss 0)
  60.        (>= cann 0)
  61.        (< miss 4)
  62.        (< cann 4)
  63.        (or (zerop miss) (>= miss cann))
  64.        (or (zerop (- 3 miss)) (>= (- 3 miss) (- 3 cann)))))
  65.  
  66. (defun build-state (miss cann boat g parent)
  67.   ;  creates a new state with parameters as specified by argument list
  68.   (prog (newstate)
  69.     (setq newstate (gensym))
  70.     (putprop newstate (list miss cann boat) 'position)
  71.     (putprop newstate g 'g)
  72.     (putprop newstate (heuristic miss cann boat) 'h)
  73.     (putprop newstate parent 'parent)
  74.     (return newstate)))
  75.  
  76. (defun heuristic (miss cann boat)
  77.   ;  our heuristic (h) function
  78.   (cond ((equal boat 'left)
  79.      (* 2 (+ miss cann)))
  80.     (t  ;  boat is on right
  81.      (* 2 (max 0 (+ miss cann -2))))))
  82.  
  83. (defun goal (state)
  84.   ;  returns true if state is a goal state (no missionaries or cannibals on right)
  85.   (and (zerop (car (get state 'position)))
  86.        (zerop (cadr (get state 'position)))))
  87.  
  88. (defun print-solution (state)
  89.   ;  invoked by search algorithm with goal state,
  90.   ;  prints sequence of states from initial state to goal.
  91.   (cond ((null state)
  92.       (print 'solution:))
  93.      (t
  94.       (print-solution (get state 'parent))
  95.       (print (get state 'position))
  96.      ))
  97. )
  98.  
  99. (defun trace (comment state)
  100.   ; if trace-switch is true, print out comment and position
  101.   ; associated with state
  102.   (cond 
  103.     (trace-switch
  104.       (print `(,comment state ,state with position ,(get state 'position)
  105.                h(x) =  ,(get state 'h))))))
  106.  
  107.